home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / UnitsConverter.pdrx < prev   
Text File  |  1992-06-15  |  7KB  |  367 lines
  1. /*
  2. @N
  3.  
  4. UnitsConverter allows you to enter values in inches, points, picas, cm, ciceros, or agates, and convert to all other units.
  5. */
  6. numeric digits 8
  7. cr = '0a'x 
  8. dnumbers = " 1234567890."
  9. numbers = " 1234567890"
  10. signal on syntax
  11.  
  12. /* load in math library    */
  13. msg = PDSetup.rexx(2,0)
  14. units = getclip(pds_units)
  15. if msg ~= 1 then exit_msg(msg)
  16.  
  17. /* start with decimal fraction of 1 inch  */
  18. dinches  = 1
  19. points   = ""
  20. inches   = ""
  21. pica  = ""
  22. cicero   = ""
  23. cent  = ""
  24. agates    = ""
  25.  
  26. do forever
  27.  
  28.       if inches ~= '' then
  29.       do
  30.  
  31.          if verify(inches, " 1234567890./") ~= 0 then
  32.             call exit_msg('Invalid Entry')
  33.  
  34.          dinch = ftod(inches)
  35.  
  36.       end
  37.       else if dinches ~= '' then
  38.       do
  39.  
  40.          if verify(dinches, dnumbers) ~= 0 then
  41.             call exit_msg('Invalid Entry')
  42.  
  43.          dinch = dinches
  44.  
  45.       end
  46.       else if pica ~= '' then
  47.       do
  48.  
  49.          if verify(pica, " 1234567890.Pp") ~= 0 then
  50.             call exit_msg('Invalid Entry')
  51.  
  52.          dinch = ptoint(pica)
  53.  
  54.       end
  55.       else if points ~= '' then
  56.       do
  57.  
  58.          if verify(points, " 1234567890.") ~= 0 then
  59.             call exit_msg('Invalid Entry')
  60.  
  61.          dinch = points / 72
  62.  
  63.       end
  64.       else if cent ~= '' then
  65.       do
  66.          if verify(cent, dnumbers) ~= 0 then
  67.             call exit_msg('Invalid Entry')
  68.  
  69.          dinch = cent / 2.54
  70.  
  71.       end
  72.       else if agates ~= '' then
  73.       do
  74.          if ~datatype(agates, n) then
  75.             call exit_msg('Invalid Entry')
  76.  
  77.         dinch = agates / 14
  78.  
  79.       end
  80.       else if cicero ~= '' then
  81.       do
  82.          if verify(cicero, " 1234567890Cc.") ~= 0 then
  83.             call exit_msg('Invalid Entry')
  84.  
  85.          dinch = ctoint(cicero)
  86.  
  87.       end
  88.       else
  89.          exit
  90.  
  91.    if inches   = '' then inches  = dtof(dinch)
  92.    if dinches  = '' then dinches = dinch
  93.    if cent     = '' then cent    = dinch * 2.54
  94.    if pica     = '' then pica    = itop(dinch)
  95.    if points   = '' then points  = dinch * 72
  96.    if cicero   = '' then cicero  = itoc(dinch)
  97.    if agates   = '' then agates  = (dinch * 14) % 1
  98.  
  99.    form = "Fractional Inches:"inches || cr"Decimal Inches:"dinches || cr"Picas:"pica || cr"Points:"points || cr"Centimetres:"cent || cr"Ciceros:"cicero||cr"Agates:"agates
  100.  
  101.    entry = pdm_GetForm("Conversion yields..", 18, form)
  102.    if entry = '' then exit
  103.    parse var entry ninches '0a'x ndinches '0a'x npicas '0a'x npoints '0a'x ncent '0a'x nciceros '0a'x nagates
  104.  
  105.    if compare(ninches, inches) ~= 0 then
  106.    do
  107.       inches   = ninches
  108.       pica  = ''
  109.       cent  = ''
  110.       points   = ''
  111.       dinches  = ''
  112.       cicero   = ''
  113.       agates   = ''
  114.    end
  115.    else if compare(dinches, ndinches ) ~= 0 then
  116.    do
  117.       dinches  = ndinches
  118.       pica  = ''
  119.       cent  = ''
  120.       points   = ''
  121.       inches   = ''
  122.       agates   = ''
  123.       cicero   = ''
  124.    end
  125.    else if compare(pica, npicas ) ~= 0 then
  126.    do
  127.       pica  = npicas
  128.       cent  = ''
  129.       points   = ''
  130.       inches   = ''
  131.       dinches  = ''
  132.       cicero   = ''
  133.       agates   = ''
  134.  
  135.    end
  136.    else if compare(points, npoints ) ~= 0 then
  137.    do
  138.       cent  = ''
  139.       points   = npoints
  140.       pica  = ''
  141.       inches   = ''
  142.       dinches  = ''
  143.       agates   = ''
  144.       cicero   = ''
  145.    end
  146.    else if compare(cent, ncent ) ~= 0 then
  147.    do
  148.       dinches  = ''
  149.       pica  = ''
  150.       cent  = ncent
  151.       points   = ''
  152.       inches   = ''
  153.       agates   = ''
  154.       cicero   = ''
  155.    end
  156.    else if compare(cicero, nciceros) ~= 0 then
  157.    do
  158.       dinches  = ''
  159.       pica  = ''
  160.       cent  = ''
  161.       points   = ''
  162.       agates   = ''
  163.       inches   = ''
  164.       cicero   = nciceros
  165.    end
  166.    else if compare(agates, nagates) ~= 0 then
  167.    do
  168.       dinches  = ''
  169.       pica  = ''
  170.       cent  = ''
  171.       points   = ''
  172.       inches   = ''
  173.       cicero   = ''
  174.       agates   = nagates % 1
  175.    end
  176.    else exit
  177.  
  178. end
  179.  
  180. exit
  181.  
  182. exit_msg:
  183. do
  184.    parse arg message
  185.  
  186.    call pdm_Inform(1, message, )
  187.    exit
  188. end
  189.  
  190. itop: procedure
  191. do
  192.    arg iinches
  193.  
  194.    picas    = pdm_ConvertUnits(1, 3, iinches) 
  195.    intpart  = picas % 1
  196.    decpart    = substr(picas, lastpos('.', picas) + 1)
  197.  
  198.    return(intpart"p"decpart)
  199.  
  200. end
  201.  
  202. itoc: procedure
  203. do
  204.    arg iinches
  205.  
  206.    cpoints  = iinches * 66.9566
  207.    cic      = cpoints % 12
  208.    cpoints = cpoints - cic * 12 
  209.  
  210.    if cic < 1 then return("c"cpoints)
  211.    else return(cic"c"cpoints)
  212.  
  213. end
  214.  
  215.  
  216. ptoint: procedure
  217. do
  218.     arg entry
  219.     entry = upper(entry)
  220.     p = pos('P',entry)
  221.  
  222.     if p = 0 then
  223.     do
  224.         if datatype(entry) ~= 'NUM' then exit_msg("Invalid entry")
  225.         return(entry / 6 )
  226.     end
  227.     else
  228.     do
  229.         points  = substr(entry, p + 1)
  230.         picas   = left(entry, p - 1)
  231.  
  232.         if picas = '' then picas = 0 
  233.         else if ~datatype(picas,n) then exit_msg("Invalid entry")
  234.         else picas = picas / 6
  235.  
  236.         if points = '' then points = 0 
  237.         else if datatype(points) ~= 'NUM' then exit_msg("Invalid entry")
  238.         else points = points / 72
  239.         return( picas + points )
  240.  
  241.     end
  242.  
  243. end
  244.  
  245. ctoint: procedure
  246. do
  247.    arg cic
  248.  
  249.    c = pos('C',cic)
  250.    if c = 0 then c = pos('c', cic)
  251.  
  252.    decimal = pos('.', cic )
  253.  
  254.    if c = 0 then
  255.    do
  256.       return(cic * .1792 )
  257.    end
  258.    else
  259.    do
  260.       pcics = substr(cic, (c+1))
  261.       cic      = strip(left(cic, c - 1))
  262.  
  263.       if cic = '' then cic = 0 
  264.       if pcics = '' then pcics = 0
  265.       else if pcics >= 12 then
  266.       do
  267.          cic      = cic + pcics % 12
  268.          pcics = pcics // 12
  269.       end
  270.  
  271.       iinches = cic * .1792 + pcics * .0149
  272.       return( iinches )
  273.  
  274.    end
  275.  
  276. end
  277.  
  278. ftod: procedure expose dnumbers numbers
  279. do
  280.    arg fraction
  281.    
  282.    decimal = 0
  283.  
  284.    wrdcnt = words( fraction )
  285.  
  286.    if wrdcnt > 2 then 
  287.       call exit_msg('Invalid Fraction entered')
  288.    else if wrdcnt = 2 then
  289.    do
  290.       decimal = word(fraction, 1)
  291.  
  292.       if verify(decimal, dnumbers) ~= 0 then
  293.          call exit_msg('Invalid Fraction entered')
  294.  
  295.       fraction = word(fraction, 2)
  296.  
  297.    end
  298.  
  299.    slash = pos('/', fraction )
  300.    if slash = 0 then
  301.     do
  302.         if datatype(fraction) ~= 'NUM' then exit_msg("Invalid entry")
  303.         else return(fraction)
  304.     end
  305.    if left(fraction, slash - 1 ) = 0 then signal syntax
  306.  
  307.    if slash = 0 then
  308.       call exit_msg('Invalid Fraction entered')
  309.  
  310.    interpret "decimal = decimal + "fraction
  311.  
  312.    return( decimal )
  313.  
  314. end
  315.  
  316. dtof: procedure
  317. do
  318.    arg decimal
  319.    xnumbers = "1234567890"
  320.  
  321.    /* Convert a decimal number to a fraction with the precision
  322.     * of 1/72
  323.     */
  324.     MAX = 72
  325.     tol = 1/MAX
  326.  
  327.    point = pos('.', decimal )
  328.  
  329.    if point = 0 then return( decimal )
  330.  
  331.    integral = left(decimal, point - 1)
  332.  
  333.  
  334.    decimal     = substr(decimal, point + 1 )
  335.  
  336.    if verify(decimal, xnumbers ) ~= 0 then
  337.       exit_msg('Invalid Fraction entered')
  338.  
  339.    curval = "."decimal
  340.    if curval < tol then return(integral)
  341.  
  342.    do gcd = 1 to ( MAX - 1 )
  343.  
  344.       n = gcd * curval
  345.       if abs(n - nint(n)) < tol then leave
  346.  
  347.    end
  348.  
  349.    numerator = max(nint(gcd * curval) % 1, 1 )
  350.  
  351.    if gcd = 1 then
  352.    do
  353.       if integral = '' then integral = 0
  354.       return( integral + numerator )
  355.    end
  356.  
  357.    return( integral" "numerator"/"gcd )
  358.  
  359. end
  360.  
  361.  
  362.  
  363. syntax:
  364. do
  365.    exit_msg("Genie failed due to error: "errortext(rc)" Line "SIGL)
  366. end
  367.